home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / Goodies / NEWINT~1 / PROGRE~1 / PROGBA~1.CLS < prev    next >
Text File  |  1997-06-04  |  7KB  |  212 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "CProgBar32"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10.  
  11. Option Explicit
  12.  
  13. Private ProgressStyle As Long
  14. Dim ProgBarWnd As Long
  15. Private TempParent As Object
  16. Private Const WM_COMMAND = &H111
  17. Private Const WM_COMMNOTIFY = &H44
  18. Private NoObjectParent As Long
  19. Private Type tagInitCommonControlsEx
  20.     lngSize As Long
  21.     lngICC As Long
  22. End Type
  23. Const ICC_PROGRESS_CLASS = &H20
  24. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  25. Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  26. Private Declare Function InitCommonControlsEx Lib "Comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
  27. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  28. Private Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapName As String) As Long
  29. Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
  30. Private Declare Function SendStringMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
  31. Private Declare Function CreateWindowEX Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  32. Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
  33. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  34. Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
  35. Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
  36. Private Const MF_OWNERDRAW& = &H100&
  37.  
  38. Const HWND_TOPMOST = -1
  39. Const SW_HIDE = 0
  40. Const SW_SHOWNORMAL = 1
  41. Const SWP_NOSIZE = &H1
  42. Const SWP_NOMOVE = &H2
  43. Const SWP_NOREDRAW = &H8
  44. Const SWP_SHOWWINDOW = &H40
  45.  
  46. Private Type tagTBADDBITMAP
  47.         hinst As Long
  48.         nID As Long
  49. End Type
  50.  
  51. Private Const COLOR_BTNFACE = 15
  52. Private Const COLOR_BTNTEXT = 18
  53.  
  54. ' Window Style constants
  55. Const WS_VISIBLE = &H10000000
  56. Const WS_CHILD = &H40000000
  57. Const WS_POPUP = &H80000000
  58.  
  59. ' CreateWindow constants
  60. Const CW_USEDEFAULT = &H80000000
  61.  
  62. Private Const WM_PAINT = &HF
  63.  
  64. Private Const WM_USER = &H400
  65. Private Const GWL_HWNDPARENT = (-8)
  66. Private Const GWL_STYLE = (-16)
  67. Private Const WS_BORDER = &H800000
  68. Private Const WM_DRAWITEM = &H2B
  69. Private Const WS_CLIPCHILDREN = &H2000000
  70. Private Const WS_CLIPSIBLINGS = &H4000000
  71. Private Const WM_SETREDRAW = &HB
  72. '//Common Control Constants
  73. Private Const CCS_TOP = &H1
  74. Private Const CCS_NOMOVEY = &H2
  75. Private Const CCS_BOTTOM = &H3
  76. Private Const CCS_NORESIZE = &H4
  77. Private Const CCS_NOPARENTALIGN = &H8
  78. 'Private Const CCS_ADJUSTABLE          0x00000020L
  79. Private Const CCS_NODIVIDER = &H40
  80.  
  81.  
  82. Private Const PROGRESS_CLASSA = "msctls_progress32"
  83.  
  84. 'Style
  85. Private Const PBS_SMOOTH = &H1
  86. Private Const PBS_VERTICAL = &H4
  87. Private Const PBM_SETRANGE = (WM_USER + 1)
  88. Private Const PBM_SETPOS = (WM_USER + 2)
  89. Private Const PBM_DELTAPOS = (WM_USER + 3)
  90. Private Const PBM_SETSTEP = (WM_USER + 4)
  91. Private Const PBM_STEPIT = (WM_USER + 5)
  92. Private Const PBM_SETRANGE32 = (WM_USER + 6)
  93. Private Const PBM_GETRANGE = (WM_USER + 7)
  94. Private Const PBM_GETPOS = (WM_USER + 8)
  95.  
  96. Private Type PPBRange
  97.         iLow As Integer
  98.         iHigh As Integer
  99. End Type
  100. Public Sub SetProgVert(Vertical As Boolean)
  101. If Vertical = True Then
  102. ProgressStyle = PBS_VERTICAL
  103. Else
  104. ProgressStyle = 0
  105. End If
  106. End Sub
  107.  
  108.  
  109. Private Sub Class_Initialize()
  110.  Dim iccex As tagInitCommonControlsEx
  111.     With iccex
  112.         .lngSize = LenB(iccex)
  113.         .lngICC = ICC_PROGRESS_CLASS
  114.     End With
  115.     Call InitCommonControlsEx(iccex)
  116.   
  117.     ProgBarWnd = 0
  118. End Sub
  119. Public Function Create( _
  120.  Optional Left As Variant, _
  121.  Optional Top As Variant, _
  122.  Optional Width As Variant, _
  123.  Optional Height As Variant, Optional Smooth As Boolean) _
  124.   As Boolean
  125.   
  126.    
  127. Dim SmoothVal As Long
  128. If Smooth = True Then SmoothVal = PBS_SMOOTH
  129.     
  130. If NoObjectParent <> 0 Then
  131. ProgBarWnd = CreateWindowEX(0, "msctls_progress32", "", _
  132.               WS_VISIBLE Or WS_CHILD Or ProgressStyle Or SmoothVal, 0, 0, 0, 0, _
  133.               NoObjectParent, 0&, App.hInstance, 0&)
  134. Call SetParent(ProgBarHwnd, NoObjectParent)
  135. Else
  136. If Parent Is Nothing Then
  137.    Create = False
  138. Exit Function
  139. End If
  140.     
  141. If IsMissing(Left) Then Left = 0
  142. If IsMissing(Top) Then Top = 0
  143. If IsMissing(Width) Then Width = Parent.Width \ Screen.TwipsPerPixelX
  144. If IsMissing(Height) Then Height = 20
  145.  
  146. ProgBarWnd = CreateWindowEX(0, "msctls_progress32", "", _
  147.              WS_VISIBLE Or WS_CHILD Or ProgressStyle Or SmoothVal, 0, 0, 0, 0, _
  148.              Parent.hwnd, 0&, App.hInstance, 0&)
  149.              Call SetParent(ProgBarHwnd, Parent.hwnd)
  150.  End If
  151.     
  152.     Call MoveWindow(ProgBarWnd, CLng(Left), CLng(Top), CLng(Width), CLng(Height), True)
  153.      
  154.     Call ShowWindow(ProgBarWnd, SW_SHOWNORMAL)
  155.        
  156.     
  157.     Create = (ProgBarWnd <> 0)
  158.    
  159. End Function
  160. Public Property Get Parent() As Object
  161. Set Parent = TempParent
  162. End Property
  163.  
  164. Public Property Set Parent(Frm As Object)
  165. Set TempParent = Frm
  166. End Property
  167.  
  168.  
  169. Private Sub Class_Terminate()
  170.  Exit Sub
  171.     If ProgBarWnd <> 0 Then
  172.         Call DestroyWindow(ProgBarWnd)
  173.     End If
  174. End Sub
  175.  
  176. Public Sub DestroyProgBar()
  177. On Error Resume Next
  178. If ProgBarWnd <> 0 Then
  179.    Call DestroyWindow(ProgBarWnd)
  180. End If
  181. End Sub
  182.  
  183. Public Sub ClearProgBar()
  184. On Error Resume Next
  185. 'Set Position to Zero
  186. Call SendMessage(ProgBarWnd, PBM_SETPOS, 0, 0)
  187. End Sub
  188.  
  189. Public Sub SetProgBarPos(ProgPos As Integer)
  190. DoEvents
  191. Call SendMessage(ProgBarWnd, PBM_SETPOS, ProgPos, 0)
  192. DoEvents
  193. End Sub
  194.  
  195. Public Sub DelayProgBar(itime As Integer)
  196. DoEvents
  197. Call Sleep(itime)
  198. DoEvents
  199. End Sub
  200.  
  201. Public Property Get SethWndParent() As Long
  202. SethWndParent = NoObjectParent
  203. End Property
  204. Public Property Get ProgBarHwnd() As Long
  205. ProgBarHwnd = ProgBarWnd
  206. End Property
  207. Public Property Let SethWndParent(ByVal vNewValue As Long)
  208. NoObjectParent = vNewValue
  209. End Property
  210.  
  211.  
  212.